home *** CD-ROM | disk | FTP | other *** search
- /*
- $VER: GetNET.Thor 1.4 (30.6.96)
- by Remco van Hooff
-
- See GetNET.thor.doc for installation instructions.
- */
-
- bbs = 'Email' /* your Internet system */
-
- /* hotlists */
- hotlist_amosaic = 'envarc:mosaic/.mosaic-hotlist-default' ; amosaic = 1
- hotlist_ibrowse = 'IBrowse:ibrowse-hotlist.html' ; ibrowse = 1
- hotlist_aweb = 'AWeb:aweb.hotlist' ; aweb = 1
- hotlist_voyager = 'Voyager:bookmarks.html' ; voyager = 1
- hotlist_html = 'path_to_hotlist:hotlist.html' ; html = 0
-
- /* loop or not */
- loop = 0
-
- /* don't edit these */
- cr = '0d'x
- lf = '0a'x
- tab= '09'x
-
- /* filter chars, expand if you want */
-
- /* after the address */
- filter.1.1 = cr
- filter.1.2 = lf
- filter.1.3 = ')'
- filter.1.4 = ','
- filter.1.5 = "'"
- filter.1.6 = '"'
- filter.1.7 = ']'
- filter.1.8 = '>'
- filter.1.9 = '}'
- filter.1.10 = '*'
- filter.1.count = 10 /* number of filters */
-
- /* in front of the address (only for email)*/
- filter.2.1 = '('
- filter.2.2 = '"'
- filter.2.3 = '<'
- filter.2.4 = '['
- filter.2.5 = '{'
- filter.2.6 = ':'
- filter.2.7 = "'"
- filter.2.8 = tab
- filter.2.count = 8
-
- /*--------------------------------------------------------------------------*/
- tempfile = 't:temp.tmp'
- OPTIONS FAILAT 31
- if left(address(), 5) = 'THOR.' then thorport = address()
- else do
- say 'THOR port not found!'
- exit 10
- end
-
- IF ~SHOW('p', 'BBSREAD') THEN DO
- ADDRESS COMMAND
- "run >nil: `GetEnv THOR/THORPath`bin/LoadBBSRead"
- "WaitForPort BBSREAD"
- END
-
- ADDRESS(thorport)
- OPTIONS RESULTS
-
- CURRENTMSG stem MSG
- IF(RC ~= 0) THEN DO
- REQUESTNOTIFY TEXT '"'THOR.LASTERROR'"' BT '"_Ok"'
- EXIT
- END
- msgnum = MSG.MSGNR
- curbbs = MSG.BBSNAME
- curconf = MSG.CONFNAME
-
- ADDRESS bbsread READBRMESSAGE BBSNAME '"'curbbs'"' CONFNAME '"'curconf'"' MSGNR msgnum HEADSTEM headtags
- IF(RC ~= 0) THEN DO
- REQUESTNOTIFY TEXT '"'BBSREAD.LASTERROR'"' BT '"_Ok"'
- EXIT
- END
- fromname = HEADTAGS.FROMNAME
- subj = HEADTAGS.SUBJECT
- IF POS('RE:',UPPER(subj)) ~=0 THEN subj = SUBSTR(subj,5)
-
- CALL main
- EXIT
-
- main:
- DROP FOUND. SAVE. NAME.
- REQUESTNOTIFY TEXT '"Choose what kind of addresses to get."' BT '"_HTTP|_Email|_Quit"'
- IF RESULT = 0 THEN EXIT
- IF RESULT = 1 THEN CALL get_http
- IF RESULT = 2 THEN CALL get_email
- IF loop = 1 THEN SIGNAL main
- RETURN
-
- /* gethttp */
- get_http:
- SAVEMESSAGE CURRENT FILENAME tempfile NOANSI OVERWRITE
- IF(RC ~= 0) THEN DO
- REQUESTNOTIFY TEXT '"'THOR.LASTERROR'"' BT '"_Ok"'
- EXIT
- END
-
- ELSE DO
- CALL gethttp
- CALL listfound
- IF ok = 1 THEN CALL listsave(1)
- END
- RETURN
-
- gethttp:
- CALL OPEN(tmp, tempfile, 'r')
- num = 0
- found.count = 0
- DO WHILE ~EOF(tmp)
- msg = READLN(tmp)
- msg = TRANSLATE(msg, 'hptw', 'HPTW')
- IF (POS('ttp://', msg) = 0 & POS('www.', msg) ~=0 ) THEN DO
- PARSE VAR msg . 'www.' httpadres .
- IF httpadres ~= ''THEN httpadres = 'www.'||httpadres
- END
- ELSE DO
- PARSE VAR msg . 'ttp://' httpadres .
- END
- IF httpadres ~= '' THEN DO
- lengte = length(httpadres)
- CALL filter(httpadres, lengte,1)
- httpadres = 'http://'||RESULT
- n = 0
- DO i = 1 TO found.count
- IF httpadres ~= found.i THEN n = n +1
- END
- IF n = found.count THEN DO
- num = num + 1
- found.num = httpadres
- found.count = num
- END
- END
- END
- CALL CLOSE(tmp)
- ADDRESS COMMAND 'delete >nil: 'tempfile
- RETURN
-
- savehotlist:
- DO i = 1 TO save.count
- IF name.i = '' THEN name.i = subj '('i')'
- END
- IF amosaic = 1 THEN CALL save_amosaic
- IF ibrowse = 1 THEN CALL save_ibrowse
- IF html = 1 THEN CALL save_html
- IF aweb = 1 THEN CALL save_aweb
- IF voyager = 1 THEN CALL save_voyager
- IF amosaic+ibrowse+html+aweb+voyager = 0 THEN Requestnotify '"No hotlist(s) selected."' '"_OK"'
- IF loop = 1 THEN SIGNAL main
- RETURN
-
- save_amosaic:
- IF ~EXISTS(hotlist_amosaic) THEN DO
- Requestnotify '"Amosaic hotlist not found!"' '"_OK"'
- RETURN
- END
- ELSE DO
- dat = DATE()
- PARSE VAR dat dagnr maand jaar
- dag = LEFT(DATE('W', DATE(S), 'S'), 3)
- datum = dag maand dagnr TIME()jaar
- CALL OPEN(htlst,hotlist_amosaic,'a')
- DO i = 1 TO save.count
- CALL WRITELN(htlst,save.i||' '||datum)
- CALL WRITELN(htlst,STRIP(name.i))
- END
- CALL CLOSE(htlst)
- END
- ADDRESS COMMAND 'copy' hotlist_amosaic 'env:mosaic/ quiet'
- RETURN
-
- save_ibrowse:
- IF ~EXISTS(hotlist_ibrowse) THEN DO
- Requestnotify '"IBrowse hotlist not found!"' '"_OK"'
- RETURN
- END
- ELSE DO
- CALL OPEN(in,hotlist_ibrowse,'r')
- CALL OPEN(out,'t:IBrowse.tmp','w')
- line = READLN(in)
- DO UNTIL line = '<UL>'
- WRITELN(out, line)
- line = READLN(in)
- END
- WRITELN(out, line)
- DO i = 1 TO save.count
- IF savename.i = '' THEN savename.i = destvar.1 '('i')'
- adres = '<LI><A HREF="'||save.i||'">'STRIP(name.i)'</A><br>'
- WRITELN(out, adres)
- END
- DO UNTIL EOF(in)
- rest = readch(in,1048576) /* 1MB should be enough :.) */
- WRITECH(out, rest)
- END
- CALL CLOSE(out)
- CALL CLOSE(in)
- ADDRESS COMMAND 'copy t:ibrowse.tmp' hotlist_ibrowse 'quiet'
- ADDRESS COMMAND 'delete t:ibrowse.tmp quiet'
- END
- RETURN
-
- save_html:
- IF ~EXISTS(hotlist_html) THEN DO
- Requestnotify '"HTML hotlist not found!"' '"_OK"'
- RETURN
- END
- ELSE DO
- CALL OPEN(htlst,hotlist_html,'a')
- DO i = 1 TO save.count
- CALL WRITELN(htlst,'<LI><A HREF="'save.i'">'STRIP(name.i)'</A><br>')
- END
- CALL CLOSE(htlst)
- END
- RETURN
-
- save_aweb:
- IF ~EXISTS(hotlist_aweb) THEN DO
- Requestnotify '"AWeb hotlist not found!"' '"_OK"'
- RETURN
- END
- ELSE DO
- CALL OPEN(htlst,hotlist_aweb,'a')
- DO i = 1 TO save.count
- CALL WRITELN(htlst,save.i)
- CALL WRITELN(htlst,STRIP(name.i))
- END
- CALL CLOSE(htlst)
- END
- RETURN
-
- save_Voyager:
- IF ~EXISTS(hotlist_voyager) THEN DO
- Requestnotify '"Voyager hotlist not found!"' '"_OK"'
- RETURN
- END
- ELSE DO
- CALL OPEN(in,hotlist_voyager,'r')
- CALL OPEN(out,'t:voyager.tmp','w')
- line = READLN(in)
- DO UNTIL line = '<UL>'
- WRITELN(out, line)
- line = READLN(in)
- END
- WRITELN(out, line)
- DO i = 1 TO save.count
- IF savename.i = '' THEN savename.i = destvar.1 '('i')'
- adres = '<LI><A HREF="'||save.i||'">'STRIP(name.i)'</A><br>'
- WRITELN(out, adres)
- END
- DO UNTIL EOF(in)
- rest = readch(in,1048576) /* 1MB should be enough :.) */
- WRITECH(out, rest)
- END
- CALL CLOSE(out)
- CALL CLOSE(in)
- ADDRESS COMMAND 'copy t:voyager.tmp' hotlist_voyager 'quiet'
- ADDRESS COMMAND 'delete t:voyager.tmp quiet'
- END
- RETURN
-
- /* end gethttp */
-
- /* getemail */
- get_email:
- SAVEMESSAGE CURRENT FILENAME tempfile NOHEADER NOANSI OVERWRITE
- IF(RC ~= 0) THEN DO
- 'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
- EXIT
- END
- ELSE DO
- CALL getemail
- CALL listfound
- IF ok = 1 THEN CALL listsave(2)
- END
- RETURN
-
- getemail:
- CALL OPEN(tmp, tempfile, 'r')
- num = 0
- found.count = 0
- DO WHILE ~EOF(tmp)
- msg = READLN(tmp)
- PARSE VAR msg part1 '@' part2 '.' part3 rest
- DO FOREVER
- IF (part2 ~= '' & POS(' ',part2) = 0 & part3 ~= '') THEN DO
- spc = LASTPOS(' ', part1)
- IF spc ~= 0 THEN part1 = DELSTR(part1, 1, spc)
- lengte = LENGTH(part1)
- CALL filter(part1,lengte,2)
- part1 = RESULT
- lengte = LENGTH(part3)
- CALL FILTER(part3,lengte,1)
- part3 = RESULT
- email = part1'@'part2'.'adres
- n = 0
- DO i = 1 TO found.count
- IF email ~= found.i THEN n = n +1
- END
- IF n = found.count THEN DO
- num = num + 1
- found.num = email
- found.count = num
- END
- END
- IF POS('@', rest) ~= 0 THEN DO
- PARSE VAR rest part1 '@' part2 '.' part3 rest
- empty = 0
- END
- ELSE empty = 1
- IF empty = 1 THEN LEAVE
- END
- END
- CALL CLOSE(tmp)
- ADDRESS COMMAND 'delete >nil:' tempfile
- RETURN
-
- userdata:
- IF alias.n = 'ALIAS.'n THEN alias.n = ''
- IF comm.n = 'COMM.'n THEN comm.n = ''
- showdata.1 = 'name :' name.n
- showdata.2 = 'address :' save.n
- showdata.3 = 'alias :' alias.n
- showdata.4 = 'comment :' comm.n
- showdata.5 = ''
- showdata.6 = 'RETURN'
- showdata.count = 6
- titel = 'Userdata for' save.n
- REQUESTLIST INSTEM showdata TITLE '"'titel'"' SIZEGADGET
- IF (RC = 30) THEN DO
- REQUESTNOTIFY TEXT '"'THOR.LASTERROR'"' BT '"_Ok"'
- EXIT
- END
- IF RC ~= 5 THEN DO
- sel = RESULT
- IF sel = showdata.1 THEN DO
- RESULT = name.n
- REQUESTSTRING TITLE '"Enter a name for"' BT '"_OK|_From:|_Cancel"' BODY '"'save.n'"' INITIALSTRING '"'name.n'"'
- IF THORRC = 0 then name.n = ''
- IF THORRC = 1 then name.n = RESULT
- IF THORRC = 2 THEN name.n = fromname
- END
- IF sel = showdata.2 THEN DO
- RESULT = save.n
- REQUESTSTRING TITLE '"Change address"' BT '"_OK|_Cancel"' BODY '"'save.n'"' INITIALSTRING '"'save.n'"'
- save.n = RESULT
- END
- IF sel = showdata.3 THEN DO
- RESULT = alias.n
- REQUESTSTRING TITLE '"Enter an alias for"' BT '"_OK|_Cancel"' BODY '"'save.n'"' INITIALSTRING '"'alias.n'"'
- alias.n = RESULT
- END
- IF sel = showdata.4 THEN DO
- RESULT = comm.n
- REQUESTSTRING TITLE '"Enter a comment for"' BT '"_OK|_Cancel"' BODY '"'save.n'"' INITIALSTRING '"'comm.n'"'
- comm.n = RESULT
- END
- IF sel = 'RETURN' THEN SIGNAL listsave(2)
- SIGNAL userdata
- END
- ELSE SIGNAL main
- RETURN
-
- save_userdata:
- DROP USER.
- DO i = 1 TO save.count
- IF name.i = '' THEN DO
- PARSE VAR save.i part1 '@'
- name.i = part1
- END
- USER.NAME = name.i
- USER.ADDRESS = save.i
- USER.ALIAS = alias.i
- USER.COMMENT.1 = comm.i
- IF USER.COMMENT.1 = '' THEN USER.COMMENT.COUNT = 0
- ELSE USER.COMMENT.COUNT = 1
- ADDRESS BBSREAD WRITEBRUSER BBSNAME '"'bbs'"' STEM USER ONLYIFEXIST
- IF RC~=0 THEN DO
- REQUESTNOTIFY '"'BBSREAD.LASTERROR'"' '"_Ok"'
- CALL EXIT
- END
- END
- IF loop = 1 THEN SIGNAL main
- RETURN
- /* end getemail */
-
- filter:
- PARSE ARG adres,lngth,fltr
- IF fltr = 2 THEN adres=REVERSE(adres)
- DO i = 1 TO filter.fltr.count
- check = POS(filter.fltr.i, adres)
- IF check ~=0 THEN adres = DELSTR(adres, check)
- END
- punt = LASTPOS('.', adres)
- IF punt ~=0 THEN lngth = length(adres)
- IF (punt = lngth) THEN adres = DELSTR(adres, punt)
- IF fltr = 2 THEN adres=REVERSE(adres)
- RETURN(adres)
-
- listfound:
- IF found.COUNT > 0 THEN DO
- REQUESTLIST INSTEM found OUTSTEM save TITLE '"Select address(es) to save"' MULTISELECT SIZEGADGET
- IF (RC = 30) THEN DO
- REQUESTNOTIFY TEXT '"'THOR.LASTERROR'"' BT '"_Ok"'
- EXIT
- END
- IF RC ~= 5 THEN ok = 1
- END
- IF found.COUNT = 0 THEN DO
- REQUESTNOTIFY '"No addresses found in this message."' '"_Ok"'
- EXIT
- END
- RETURN
-
- listsave:
- PARSE ARG soort
- DO i = 1 TO save.count
- IF name.i = 'NAME.'i THEN name.i = ''
- showname.i = LEFT(name.i,20,' ')
- show.i = showname.i' - 'save.i
- END
- sep = save.count +1
- but = save.count +2
- show.sep = ''
- show.but = 'SAVE'
- show.count = save.count+2
- IF soort = 1 THEN titel = 'Select to enter a name'
- IF soort = 2 THEN titel = 'Select address to edit userdata'
- REQUESTLIST INSTEM show TITLE '"'titel'"' SIZEGADGET
- IF (RC = 30) THEN DO
- REQUESTNOTIFY TEXT '"'THOR.LASTERROR'"' BT '"_Ok"'
- EXIT
- END
- IF RC ~= 5 THEN DO
- selected = RESULT
- IF selected = 'SAVE' THEN DO
- IF soort = 1 THEN SIGNAL savehotlist
- IF soort = 2 THEN SIGNAL save_userdata
- END
- DO n = 1 TO save.count
- IF selected = show.n THEN DO
- IF soort = 1 THEN DO
- REQUESTSTRING title '"Enter a name"' BT '"_OK|_Cancel"' BODY '"'save.n'"' INITIALSTRING '"'name.n'"'
- name.n = RESULT
- END
- IF soort = 2 THEN SIGNAL userdata
- END
- END
- IF soort = 1 THEN SIGNAL listsave(1)
- IF soort = 2 THEN SIGNAL listsave(2)
- END
- RETURN
-